home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch10 / SierpBox.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-08  |  4KB  |  116 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSierpBox 
  3.    Caption         =   "SierpBox"
  4.    ClientHeight    =   4335
  5.    ClientLeft      =   2280
  6.    ClientTop       =   900
  7.    ClientWidth     =   5310
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4335
  11.    ScaleWidth      =   5310
  12.    Begin VB.TextBox txtDepth 
  13.       Height          =   285
  14.       Left            =   480
  15.       MaxLength       =   3
  16.       TabIndex        =   0
  17.       Text            =   "3"
  18.       Top             =   0
  19.       Width           =   375
  20.    End
  21.    Begin VB.PictureBox picCanvas 
  22.       AutoRedraw      =   -1  'True
  23.       Height          =   4335
  24.       Left            =   960
  25.       ScaleHeight     =   285
  26.       ScaleMode       =   3  'Pixel
  27.       ScaleWidth      =   285
  28.       TabIndex        =   3
  29.       Top             =   0
  30.       Width           =   4335
  31.    End
  32.    Begin VB.CommandButton cmdGo 
  33.       Caption         =   "Go"
  34.       Default         =   -1  'True
  35.       Height          =   375
  36.       Left            =   120
  37.       TabIndex        =   1
  38.       Top             =   480
  39.       Width           =   615
  40.    End
  41.    Begin VB.Label Label1 
  42.       Caption         =   "Depth"
  43.       Height          =   255
  44.       Index           =   0
  45.       Left            =   0
  46.       TabIndex        =   2
  47.       Top             =   0
  48.       Width           =   495
  49.    End
  50. Attribute VB_Name = "frmSierpBox"
  51. Attribute VB_GlobalNameSpace = False
  52. Attribute VB_Creatable = False
  53. Attribute VB_PredeclaredId = True
  54. Attribute VB_Exposed = False
  55. Option Explicit
  56. ' Erase the center rectangle from this one.
  57. Private Sub SierpinskiErase(ByVal depth As Integer, ByVal x1 As Single, ByVal y1 As Single, ByVal x4 As Single, ByVal y4 As Single)
  58. Dim x2 As Single
  59. Dim y2 As Single
  60. Dim x3 As Single
  61. Dim y3 As Single
  62.     ' Find the corners of the middle square.
  63.     x2 = (2 * x1 + x4) * 0.3333
  64.     x3 = (x1 + 2 * x4) * 0.3333
  65.     y2 = (2 * y1 + y4) * 0.3333
  66.     y3 = (y1 + 2 * y4) * 0.3333
  67.     ' Erase the middle rectangle.
  68.     picCanvas.Line (x2, y2)-(x3, y3), picCanvas.BackColor, BF
  69.     ' Recursively erase other rectangles.
  70.     If depth > 0 Then
  71.         SierpinskiErase depth - 1, x1, y1, x2, y2
  72.         SierpinskiErase depth - 1, x2, y1, x3, y2
  73.         SierpinskiErase depth - 1, x3, y1, x4, y2
  74.         SierpinskiErase depth - 1, x1, y2, x2, y3
  75.         SierpinskiErase depth - 1, x3, y2, x4, y3
  76.         SierpinskiErase depth - 1, x1, y3, x2, y4
  77.         SierpinskiErase depth - 1, x2, y3, x3, y4
  78.         SierpinskiErase depth - 1, x3, y3, x4, y4
  79.     End If
  80. End Sub
  81. ' Draw a complete Sierpinski carpet.
  82. Private Sub SierpinskiCarpet(ByVal depth As Integer, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single)
  83.     ' Erase the picture.
  84.     picCanvas.Line (0, 0)-(picCanvas.ScaleWidth, picCanvas.ScaleHeight), picCanvas.BackColor, BF
  85.     ' Draw the main filled box.
  86.     picCanvas.AutoRedraw = True
  87.     picCanvas.Line (x1, y1)-(x2, y2), vbBlack, BF
  88.     ' If depth > 0, call SierpinskiErase to
  89.     ' erase the center of this box.
  90.     If depth >= 0 Then
  91.         SierpinskiErase depth, x1, y1, x2, y2
  92.     End If
  93. End Sub
  94. Private Sub CmdGo_Click()
  95. Dim depth As Integer
  96.     MousePointer = vbHourglass
  97.     DoEvents
  98.     ' Get the parameters.
  99.     If Not IsNumeric(txtDepth.Text) Then txtDepth.Text = "5"
  100.     depth = CInt(txtDepth.Text)
  101.     ' Draw the curve.
  102.     SierpinskiCarpet depth, _
  103.         picCanvas.ScaleWidth * 0.02, _
  104.         picCanvas.ScaleHeight * 0.02, _
  105.         picCanvas.ScaleWidth * 0.98, _
  106.         picCanvas.ScaleHeight * 0.98
  107.     MousePointer = vbDefault
  108. End Sub
  109. Private Sub Form_Resize()
  110. Dim wid As Single
  111.     wid = ScaleWidth - picCanvas.Left
  112.     If wid < 120 Then wid = 120
  113.     picCanvas.Move picCanvas.Left, 0, _
  114.         wid, ScaleHeight
  115. End Sub
  116.